Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / yahtzee.bas (.txt) < prev next >

Wrap

GW-BASIC | 1984-04-24 | 16.0 KB | 620 lines

10 ' *********************************************************************** 20 ' * * 30 ' * ORIGINAL BY JL HELMS & MF PEZOK FOR CCII * 40 ' * * 50 ' * YATZEE * 60 ' * * 70 ' * CORONADO, CA * 80 ' * * 90 ' * ADAPTED TO IBM PC BY PATRICK LEABO * 100 '* TUCSON, AZ * 110 '* * 120 '* Uploaded to PCanada by Mark Magner (PC296) April 13, 1983 * 130 '*********************************************************************** 140 ' 150 DEFINT A-Z 160 DIM C(5):DIM K(18,7):DIM F(5):DIM A$(7) 170 DIM S(6,5):DIM M(13),TN(6),DU(6):KEY OFF:COLOR 7,0:WIDTH 80 180 SCREEN 0,1:RESTORE 240:FOR N= 1 TO 6:READ TN(N):NEXT 190 DEF SEG=&H40 : POKE &H17, PEEK (&H17) OR 64 ' Set Caps Lock 200 GOSUB 4160 210 C1= 39:C2= 63:C3= 33:C4= 56 220 GOSUB 3730 230 CLS:GOSUB 3520 240 DATA 49,51,53,54,56,61 250 GOSUB 5890:REM draw yatzee board 260 RANDOMIZE VAL(RIGHT$(TIME$,2)) 270 LOCATE 25,1 280 PRINT "HOW MANY PLAYERS? ";:LOCATE ,,1:GOSUB 1180 290 GOSUB 6170: N=ASC(KB$)-48 300 IF N< 1 OR N> 5 THEN 270 310 IF N< 5 THEN GOSUB 5070 320 IF CC= 1 THEN GOSUB 4550 330 FOR A= 1 TO N 340 LOCATE 25,1:PRINT STRING$(70," ");:LOCATE 25,1 350 PRINT "PLAYER NUMBER "A;" NAME PLEASE "; 360 GOSUB 1180:LINE INPUT ;A$(A):IF A$(A)= "" THEN BEEP:GOTO 340 370 A$(A)=LEFT$(A$(A),9) 380 NEXT A 390 IF CC= 1 THEN N= N+ 1:A$(N)= "IBM PC" 400 LOCATE 23,1 410 A= 0 420 REM 430 REM NEXT ROLL PRESET 440 REM 450 A= A+ 1:IF A> N THEN A= 1 460 H= 0:GOSUB 4410 470 IF A= 0 THEN 3830 480 IF K(18,A)= 2 THEN 450 490 LOCATE 23,1:PRINT STRING$(60," "); 500 LOCATE 23,4* (A- 1)+ 14 510 PRINT A$(A); 520 REM 530 REM INITIAL ROLL 540 REM 550 H= H+ 1:MR= 0 560 FOR B= 1 TO 5 570 J= B- 1:C(B)= INT (6* RND (1)+ 1) 580 DIE= C(B):F(B)= 0 590 GOSUB 4320 600 GOSUB 4600 610 NEXT B 620 IF A* CC= N THEN 1230 630 REM 640 REM PLAYER SELECTS QTY TO ROLL 650 REM 660 GOSUB 6150 670 IF H> 2 THEN 1030 680 POKE 106,0:PRINT " HOW MANY DICE TO ROLL AGAIN? ";:LOCATE ,,1:GOSUB 1170:GOSUB 6170:F$=KB$:PRINT F$;:F=ASC(F$)-48:LOCATE ,,0 690 IF F= - 1 THEN GOSUB 35000 700 IF F< 0 OR F> 5 THEN 660 710 IF F= 0 THEN 1030 720 IF F= 5 THEN 520 730 REM 740 REM PLAYER SELECTS DICE TO ROLL 750 REM 760 H= H+ 1 770 GOSUB 6150 780 FOR NN= 1 TO 4:F(NN)= 0:NEXT 790 PRINT " ROLL WHICH";F;"DICE AGAIN ";:LOCATE ,,1 800 GOSUB 1180:FOR ND= 1 TO F: 810 GOSUB 6170:F$=KB$::F(ND)= ASC(F$)- 48:GOSUB 1210:IF F(ND)= 0 AND ND= 1 THEN ND= F:GOTO 830 820 IF F(ND)< 1 OR F(ND)> 5 THEN 810 830 PRINT F(ND);:NEXT 840 X= 2:XF= 0 850 FOR J= 1 TO F 860 IF F= 1 THEN 880 870 IF F(J)= F(J+ 1)THEN X= 1 880 IF F(1)= 0 THEN XF= 1 890 NEXT J:IF XF= 1 THEN H= H- 1:GOTO 660 900 ON X GOTO 770,910 910 REM 920 REM PLAYER ROLLS DICE AGAIN 930 REM 940 FOR B= 1 TO 4 950 IF F(B)= 0 THEN 1010 960 C(F(B))= INT (6* RND (1)+ 1) 970 DIE= C(F(B)):J= F(B)- 1 980 GOSUB 4320 990 GOSUB 4600 1000 F(B)= 0 1010 NEXT B 1020 GOTO 630 1030 REM 1040 REM PLAY BOARD NUMBER 1050 REM 1060 GOSUB 6150 1070 PRINT " PLAY BOARD NUMBER? ";:LOCATE ,,1:GOSUB 1170:GOSUB 6170:I$=KB$:I=ASC(I$)- 48:LOCATE ,,0:IF I> 9 THEN I= I- 7 1080 GOSUB 1210:IF I> 9 THEN PRINT CHR$ (I+ 55);:GOTO 1100 1090 PRINT I; 1100 IF I< 1 OR I> 13 THEN 1060 1110 IF I= 12 AND K(12,A)> - 1 THEN 1230 1120 IF K(I,A)= 0 THEN 1230 1130 LOCATE 24,1:BEEP 1140 PRINT "NO - NO - DUMMY - - TRY AGAIN";:FOR ND=1 TO 1500:NEXT:LOCATE 24,1:PRINT STRING$(60," "); 1150 LOCATE 25,1:PRINT STRING$(60," ");:LOCATE 25,1 1160 GOTO 1070 1170 REM HIGH PITCH CLICK 1180 PLAY "L64T200N70":RETURN 1190 REM GLISSANDO SOUND 1200 PLAY "MBt255MLL64O5CC#DD#EFF#GG#AA#B":RETURN 1210 ' LO PITCH CLICK 1220 PLAY "L64T200N46":RETURN 1230 REM 1240 REM DICE LOGIC 1250 REM CLEAR/SET S(M,K) 1260 REM 1270 FOR M= 0 TO 6 1280 FOR K= 0 TO 5 1290 S(M,K)= 0 1300 NEXT K 1310 NEXT M 1320 FOR J= 1 TO 5 1330 X= C(J):S(X,0)= S(X,0)+ 1 1340 P= S(X,0):S(X,P)= J 1350 NEXT J 1360 REM 1370 REM SET S(0,K)=M SEQUENCE BY QTY 1380 REM 1390 X= 0 1400 FOR J= 5 TO 1 STEP - 1 1410 FOR M= 6 TO 1 STEP - 1 1420 IF S(M,0)< > J THEN 1440 1430 S(0,X)= M:X= X+ 1 1440 NEXT M 1450 NEXT J 1460 IF A* CC= N THEN 1830 1470 IF I> 6 THEN 1550 1480 REM 1490 REM CHECK PLAYER BOARD 1-6 1500 REM 1510 GOSUB 5180 1520 IF X= - 1 THEN 1810 1530 K(I,A)= I* S(S(0,X),0) 1540 GOTO 3070 1550 REM 1560 REM CHECK PLAYER BOARD 7-13 1570 REM 1580 ON I- 6 GOTO 1590,1610,1630,1650,1700,1740,1770 1590 IF S(S(0,0),0)< 3 THEN 1810 1600 GOSUB 5260:GOTO 3070 1610 IF S(S(0,0),0)< 4 THEN 1810 1620 GOSUB 5260:GOTO 3070 1630 IF S(S(0,0),0)< > 3 OR S(S(0,1),0)< > 2 THEN 1810 1640 K(9,A)= 25:GOTO 3070 1650 IF S(1,0)> 0 AND S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 THEN 1690 1660 IF S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 THEN 1690 1670 IF S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 AND S(6,0)> 0 THEN 1690 1680 GOTO 1810 1690 K(10,A)= 30:GOTO 3070 1700 IF S(1,0)AND S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)= 1 THEN 1730 1710 IF S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)AND S(6,0)= 1 THEN 1730 1720 GOTO 1810 1730 K(11,A)= 40:GOTO 3070 1740 IF S(S(0,0),0)< > 5 THEN 1810 1750 IF K(12,A)= 0 THEN K(12,A)= 50:GOTO 3070 1760 K(12,A)= K(12,A)+ 100:GOTO 3070 1770 GOSUB 5260:GOTO 3070 1780 REM 1790 REM SET PLAYER INVALID 1800 REM 1810 K(I,A)= - 1 1820 GOTO 3070 1830 REM 1840 REM COMPUTER CHECKS 1850 REM 1860 I= 12 1870 IF S(S(0,0),0)= 5 AND K(12,A)= 0 THEN K(12,A)= 50:GOTO 3070 1880 IF S(S(0,0),0)= 5 AND K(12,A)> 0 THEN K(12,A)= K(12,A)+ 100:GOTO 3070 1890 I= 8 1900 IF S(S(0,0),0)= 4 AND K(8,A)= 0 THEN GOSUB 5260:GOTO 3070 1910 I= 9 1920 IF S(S(0,0),0)= 3 AND S(S(0,1),0)= 2 AND K(9,A)= 0 THEN K(9,A)= 25:GOTO 3070 1930 IF K(11,A)< > 0 THEN 1990 1940 I= 11 1950 IF S(1,0)AND S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)= 1 THEN 1980 1960 IF S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)AND S(6,0)= 1 THEN 1980 1970 GOTO 1990 1980 K(11,A)= 40:GOTO 3070 1990 IF K(10,A)< > 0 THEN 2060 2000 I= 10 2010 IF S(1,0)> 0 AND S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 THEN 2050 2020 IF S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 THEN 2050 2030 IF S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 AND S(6,0)> 0 THEN 2050 2040 GOTO 2060 2050 K(10,A)= 30:GOTO 3070 2060 IF H< 3 THEN 2230 2070 I= 6 2080 IF S(6,0)> 2 AND K(6,A)= 0 THEN K(6,A)= 6* S(6,0):GOTO 3070 2090 I= 5 2100 IF S(5,0)> 2 AND K(5,A)= 0 THEN K(5,A)= 5* S(5,0):GOTO 3070 2110 I= 4 2120 IF S(4,0)> 2 AND K(4,A)= 0 THEN K(4,A)= 4* S(4,0):GOTO 3070 2130 I= 3 2140 IF S(3,0)> 2 AND K(3,A)= 0 THEN K(3,A)= 3* S(3,0):GOTO 3070 2150 I= 7 2160 IF S(S(0,0),0)> 2 AND K(7,A)= 0 THEN GOSUB 5260:GOTO 3070 2170 I= 2 2180 IF S(2,0)> 2 AND K(2,A)= 0 THEN K(2,A)= 2* S(2,0):GOTO 3070 2190 I= 1 2200 IF S(1,0)> 2 AND K(1,A)= 0 THEN K(1,A)= S(1,0):GOTO 3070 2210 I= 13:IF K(13,A)< > 0 THEN 2230 2220 IF C(1)+ C(2)+ C(3)+ C(4)+ C(5)> 19 THEN GOSUB 5260:GOTO 3070 2230 REM 2240 REM CLEAR DICE NUMBER F(B) 2250 REM COMPUTER 2260 REM 2270 FOR B= 1 TO 5 2280 F(B)= 0 2290 NEXT B 2300 REM 2310 REM GET DICE CONTROL 2320 REM COMPUTER 2330 REM 2340 H= H+ 1:IF H> 3 THEN 2930 2350 I= M(MR):IF I< > 0 THEN 2380 2360 MR= MR+ 1:IF MR> 13 THEN MR= 1 2370 GOTO 2350 2380 IF I= 12 AND K(12,A)> - 1 THEN 2420 2390 IF K(I,A)< > 0 THEN 2360 2400 IF I= 9 THEN 2530 2410 IF I= 10 OR I= 11 THEN 2650 2420 REM 2430 REM GET DICE 1,2,3,4 2440 REM COMPUTER 2450 REM 2460 M= 0:J= 1 2470 M= M+ 1:IF M> 4 THEN 2810 2480 K= S(0,M):IF K= 0 THEN 2810 2490 FOR L= 1 TO S(K,0) 2500 F(J)= S(K,L):J= J+ 1 2510 NEXT L 2520 GOTO 2470 2530 REM 2540 REM GET DICE FH 2550 REM COMPUTER 2560 REM 2570 M= 0:J= 1 2580 M= M+ 1:IF M> 4 THEN 2810 2590 K= S(0,M):IF K= 0 THEN 2810 2600 IF K> 1 THEN 2580 2610 FOR L= 1 TO S(K,0) 2620 F(J)= S(K,L):J= J+ 1 2630 NEXT L 2640 GOTO 2580 2650 REM 2660 REM GET DICE LG/SM ST 2670 REM COMPUTER 2680 REM 2690 M= 0:J= 1 2700 M= M+ 1:IF M> 4 THEN 2770 2710 K= S(0,M):IF K= 0 THEN 2770 2720 IF S(K,0)= 1 THEN 2700 2730 FOR L= 1 TO S(K,0) 2740 F(J)= S(K,L):J= J+ 1 2750 NEXT L 2760 GOTO 2700 2770 IF F(1)< > 0 THEN 2810 2780 L= INT (2* RND (1)+ 1) 2790 F(1)= 5 2800 IF L= 1 THEN F(1)= 1 2810 REM 2820 REM COMPUTER ROLL AGAIN 2830 REM 2840 FOR B= 1 TO 4 2850 IF F(B)< 1 THEN 2900 2860 C(F(B))= INT (6* RND (1)+ 1) 2870 DIE= C(F(B)):J= F(B)- 1 2880 GOSUB 4320 2890 GOSUB 4600 2900 F(B)= 0 2910 NEXT B 2920 GOTO 1230 2930 REM 2940 REM COMPUTER MUST SCORE 2950 REM 2960 MR= MR+ 1:IF MR> 13 THEN MR= 1 2970 I= M(MR):IF I= 0 THEN 2960 2980 IF K(I,A)< > 0 THEN 2960 2990 IF I> 6 THEN 3050 3000 GOSUB 5180 3010 IF X= - 1 THEN 3060 3020 IF K(I,A)< > 0 THMN 2960 3030 K(I,A)= S(I,0)* I 3040 IF K(I,A)< > 0 THEN 3070 3050 IF I= 13 AND K(13,A)= 0 THEN GOSUB 5260 3060 IF K(I,A)= 0 THEN K(I,A)= - 1 3070 REM 3080 REM GET SCOREBOARD TOTALS 3090 REM 3100 FOR J= 14 TO 17 3110 K(J,A)= 0 3120 NEXT J 3130 FOR J= 1 TO 6 3140 IF K(J,A)< 0 THEN 3160 3150 K(15,A)= K(15,A)+ K(J,A) 3160 NEXT J 3170 IF K(15,A)> 62 THEN K(14,A)= 35 3180 FOR J= 7 TO 13 3190 IF K(J,A)< 0 THEN 3210 3200 K(16,A)= K(16,A)+ K(J,A) 3210 NEXT J 3220 K(17,A)= K(14,A)+ K(15,A)+ K(16,A) 3230 REM 3240 REM PRINT SCORE 3250 REM 3260 GOSUB 1200 3270 COLOR 15,0 3280 FOR J= 1 TO 6 3290 IF K(J,A)< 0 THEN LOCATE J+1,4* (A- 1)+ 15:PRINT " 0";:GOTO 3320 3300 IF K(J,A)< 1 THEN 3320 3310 LOCATE J+1,4* (A- 1)+ 15:PRINT USING"###";K(J,A); 3320 NEXT J 3330 FOR J= 7 TO 13 3340 IF K(J,A)< 0 THEN LOCATE J+4,4* (A- 1)+ 15:PRINT " 0":GOTO 3370 3350 IF K(J,A)< 1 THEN 3370 3360 LOCATE J+4,4* (A- 1)+ 15:PRINT USING "###";K(J,A) 3370 NEXT J 3380 LOCATE 9,4* (A- 1)+ 15:PRINT USING "###";K(15,A) 3390 LOCATE 19,4* (A- 1)+ 15:PRINT USING "###";K(16,A) 3400 LOCATE 20,4* (A- 1)+ 15:PRINT USING "###";K(14,A) 3410 LOCATE 21,4* (A- 1)+ 15:PRINT USING "###";K(17,A) 3420 COLOR 7,0 3430 IF A* CC< > N THEN 420 3440 REM 3450 REM RESET M(I) COMPUTER PRIORITIES 3460 REM 3470 FOR B= 1 TO 13 3480 IF M(B)= 12 THEN 3500 3490 IF M(B)= I THEN M(B)= 0 3500 NEXT B 3510 GOTO 420 3520 REM 3530 REM INSTRUCTIONS 3540 REM 3550 PRINT " Y A H T Z E E ":PRINT :PRINT 3560 PRINT "THIS IS THE GAME OF YAHTZEE - " 3570 PRINT "FROM 1 TO 7 PLAYERS MAY PLAY, OR ONE MAY PLAY AGAINST THE COMPUTER," 3580 PRINT "WITH EACH PLAYERS CURRENT STATUS SHOWN ON THE SCREEN'S GAME BOARD." 3590 PRINT "YOU HAVE TO `SCORE' EACH PLAY, AND THE STRATEGY INVOLVED IS TO" 3600 PRINT "GUESS WHETHER YOU WILL BE LUCKY IN FUTURE ROLLS.":PRINT 3610 PRINT " A YAHTZEE IS FIVE OF A KIND. " 3620 PRINT " A SMALL STRAIGHT IS ANY SEQUENCE OF FOUR." 3630 PRINT " A LARGE STRAIGHT IS ANY SEQUENCE OF FIVE.":PRINT 3640 PRINT "A SECOND YAHTZEE EARNS A BONUS OF 100 POINTS (IF THE YAHTZEE IS PUT 3650 PRINT "INTO THE YAHTZEE BLOCK)..... IN ADDITION YOU WILL GET AN EXTRA TURN 3660 PRINT "AT THE END OF THE GAME" 3670 PRINT 3680 PRINT "ON EACH PLAY YOU WILL GET ONE ROLL OF THE FIVE DICE, FOLLOWED BY TWO" 3690 PRINT "CHANCES TO RE-ROLL SELECTED DICE. GOOD LUCK ON YOUR PLAYING !" 3700 PRINT:PRINT :PRINT 3710 GOSUB 1180:PRINT " Press any key to continue. . . ." 3720 AA$=INKEY$:IF AA$="" THEN 3720 3730 RETURN 3740 LOCATE 10,10:PRINT "YATZEE.BAS VER 3.2" 3750 LOCATE 12,10:PRINT "27 JUN 79" 3760 LOCATE 14,10:PRINT "DEVELOPED BY" 3770 LOCATE 15,13:PRINT "J.L. HELMS & M.F. PEZOK" 3780 LOCATE,16,13:PRINT "1009 LEYTE RD / 1321 SAIPAN RD" 3790 LOCATE 17,17:PRINT "CORONADO, CA. 92118" 3800 LOCATE 18,15:PRINT "(714) 435-6992 / 437-4659" 3810 PRINT CHR$(11) 3820 RETURN 3830 REM 3840 REM END - SORT WINNER 3850 REM 3860 X= 2:IF N= 1 THEN 3940 3870 FOR J= 1 TO N- 1 3880 IF K(17,J)> K(17,J+ 1)THEN 3920 3890 K= K(17,J):K(17,J)= K(17,J+ 1):K(17,J+ 1)= K 3900 A$= A$(J):A$(J)= A$(J+ 1):A$(J+ 1)= A$ 3910 X= 1 3920 NEXT J 3930 ON X GOTO 3830,3940 3940 REM 3950 REM PRINT WINNERS STANDINGS 3960 REM 3970 RESTORE 4270 3980 FOR J= 1 TO N 3990 LOCATE 25,1:PRINT STRING$(60," "); 4000 IF J> 1 AND J= N THEN RESTORE 4310 4010 LOCATE 25,1:READ A$ 4020 PRINT A$;" ";A$(J);" "; 4030 TT= 500* (N- J+ 1):IF TT< 1500 THEN TT= 1500 4040 FOR T= 1 TO TT:NEXT T 4050 NEXT J 4060 LOCATE 25,1:PRINT STRING$(60," "); 4070 LOCATE 24,1:PRINT "+++ END OF GAME +++"; 4080 FOR T= 1 TO 2000:NEXT T 4090 ' 4100 GOSUB 1180:LOCATE 25,1:INPUT "PLAY AGAIN? Y/N ";Y$ 4110 IF LEFT$ (Y$,1)= "Y"THEN GOSUB 4160:GOTO 200 4120 IF LEFT$ (Y$,1)= CHR$(27) THEN BEEP:GOTO 4140 4130 IF LEFT$ (Y$,1)< > "N"THEN BEEP:GOTO 4100 4140 'CHAIN "MENU",1000 4150 END 4160 REM 4170 REM CLEAR MATRICES 4180 REM 4190 FOR K= 1 TO 7 4200 FOR J= 1 TO 18 4210 K(J,K)= 0 4220 NEXT J 4230 A$(K)= "" 4240 NEXT K 4250 CLS 4260 RETURN 4270 DATA "+++ THE WINNER +++" 4280 DATA " SECOND PLACE"," THIRD PLACE " 4290 DATA " FOURTH PLACE "," FIFTH PLACE " 4300 DATA " SIXTH PLACE " 4310 DATA " DEAD LAST " 4320 REM 4330 REM ERASE DIE 4340 REM 4350 COLOR 0,7:PRINT"";: 4360 LOCATE 4* J+ 1,50:PRINT" "; 4370 LOCATE 4* J+ 2,50:PRINT" "; 4380 LOCATE 4* J+ 3,50:PRINT" "; 4390 COLOR 7,0 4400 RETURN 4410 REM 4420 REM CHECK IF DONE 4430 REM 4440 X= 0 4450 FOR J= 1 TO N 4460 Y= 2 4470 FOR K= 1 TO 13 4480 IF K(K,J)= 0 THEN Y= 1 4490 NEXT K 4500 K(18,J)= Y 4510 IF Y= 2 THEN X= X+ 1 4520 NEXT J 4530 IF X= > N THEN A= 0 4540 RETURN 4550 REM 4560 REM COMPUTER PRIORITIES INFO 4570 REM 4580 GOSUB 5850 4590 RETURN 4600 REM 4610 REM PRINT DIE 4620 REM 4630 COLOR 0,7:LOCATE ,,0 4640 REM 4650 PLAY "L32T200N=TN(DIE);" 4660 ON DIE GOTO 5000,4940,4880,4820,4760,4700 4670 ' 4680 ' SIX 4690 ' 4700 LOCATE 4*J+1,50:PRINT "";CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32); 4710 LOCATE 4*J+2,50:PRINT CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32); 4720 LOCATE 4*J+3,50:PRINT CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);:GOTO 5030 4730 ' 4740 ' FIVE 4750 ' 4760 LOCATE 4*J+1,50:PRINT "";CHR$(32);CHR$(2);CHR$(32);" ";CHR$(32);CHR$(2);" "; 4770 LOCATE 4*J+2,50:PRINT " ";CHR$(32);" ";CHR$(2);" ";CHR$(32);" "; 4780 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";CHR$(32);" ";CHR$(2);" ";:GOTO 5030 4790 ' 4800 ' FOUR 4810 ' 4820 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);" ";CHR$(32);CHR$(2);" "; 4830 LOCATE 4*J+2,50:PRINT " ";CHR$(32);CHR$(32);CHR$(32); 4840 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";CHR$(32);CHR$(2);" ";:GOTO 5030 4850 ' 4860 ' THREE 4870 ' 4880 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);" "; 4890 LOCATE 4*J+2,50:PRINT " ";CHR$(2);" "; 4900 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";:GOTO 5030 4910 ' 4920 ' TWO 4930 ' 4940 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);" "; 4950 LOCATE 4*J+2,50:PRINT " "; 4960 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";:GOTO 5030 4970 ' 4980 ' ONE 4990 ' 5000 LOCATE 4*J+1,50:PRINT "";" "; 5010 LOCATE 4*J+2,50:PRINT " ";CHR$(2);" "; 5020 LOCATE 4*J+3,50:PRINT " ";:GOTO 5030 5030 REM GET OUT 5040 COLOR 7,0 5050 LOCATE 1,1 5060 RETURN 5070 REM 5080 REM COMPUTER OPTION 5090 REM 5100 CC= 0 5110 LOCATE 25,1 5120 PRINT "DO YOU WISH TO PLAY AGAINST ME? Y/N ";:GOSUB 1180 5130 Y$=INKEY$:IF Y$="" THEN 5130 ELSE BEEP 5140 IF Y$= "N"THEN RETURN 5150 IF Y$< > "Y"THEN 5110 5160 CC= 1 5170 RETURN 5180 REM 5190 REM CHECK FOR ACES-SIXES ANY POSITION 5200 REM 5210 X= - 1 5220 FOR J= 0 TO 4 5230 IF S(0,J)= I THEN X= J 5240 NEXT J 5250 RETURN 5260 REM 5270 REM TOTAL DICE VALUE 5280 REM 5290 FOR J= 1 TO 5 5300 K(I,A)= K(I,A)+ C(J) 5310 NEXT J 5320 RETURN 5330 REM 5340 REM MATRIX INFORMATION 5350 REM 5360 REM C(5) CURRENT DICE 5370 REM K(18,7) SCOREBOARD 5380 REM COLUMNS 1-13 BOARD NUMBER 5390 REM COLUMN 14 BONUS UPPER 5400 REM COLUMN 15 TOTAL UPPER 5410 REM COLUMN 16 TOTAL LOWER 5420 REM COLUMN 17 GRAND TOTAL 5430 REM COLUMN 18 DONE/NOT DONE STATUS 5440 REM ROW 1- 7 PLAYERS SCORE 5450 REM ROW N COMPUTERS SCORE (<7 PLAYERS) 5460 REM 5470 REM F(5) DICE NUMBER TO ROLL AGAIN 5480 REM A$(7) PLAYERS NAMES 5490 REM S(6,5) COMPUTERS DICE LOGIC 5500 REM COLUMN 0 DICE NUMBER BY QTY SEQUENCE 5510 REM COLUMN 1 QTY/POSITION FOR ACES 5520 REM COLUMN 2 QTY/POSITION FOR TWOS 5530 REM COLUMN 3 QTY/POSITION FOR THREES 5540 REM COLUMN 4 QTY/POSITION FOR FOURS 5550 REM COLUMN 5 QTY/POSITION FOR FIVES 5560 REM COLUMN 6 QTY/POSITION FOR SIXES 5570 REM ROW 0 QUANTITY OF DICE 5580 REM ROW 1- 5 POSITION OF DICE IN C(5) 5590 REM 5600 REM SAMPLE S(Y,X) FOR DICE OF 5,2,4,6,4 5610 REM 5620 REM Y/X 0 1 2 3 4 5 5630 REM 0 4 6 5 2 IN QTY/VALUE SEQUENCE 5640 REM 1 NO DIE=1 5650 REM 2 1 2 1 TWO POSITION 2 5660 REM 3 NO DIE=3 5670 REM 4 2 3 5 2 FOURS POSITIONS 3 AND 5 5680 REM 5 1 1 1 FIVE POSITION 1 5690 REM 6 1 4 1 SIX POSITION 4 5700 REM + + 5710 REM + + ++++++++++++++++ SECTION FOR POSITION DATA 5720 REM + +------------------ COLUMN INDICATES QTY 5730 REM +------------------------ INDEX EQUATES TO DIE VALUE 5740 REM 5750 REM M(13) PRIORITY NUMBERS FOR MUST SCORE WHERE VALUE 5760 REM REFERS TO PLAY BOARD NUMBER 5770 REM 5780 REM TO RUN INTERNAL CHECKS SECTION - ENTER A -1 FOR 5790 REM PLAYING BOARD NUMBER OR QTY OF DICE TO ROLL 5800 REM AGAIN - - DATA WILL NOT BE LOST AND SCREEN 5810 REM WILL BE RESET WITH CURRENT DICE SHOWN - - 5820 REM PLAYERS/COMPUTERS SCORE WILL NOT SHOW UNTIL 5830 REM AFTER THEIR TURN 5840 REM 5850 REM COMPUTER PRIORIRIES 5860 RESTORE 5870 5870 DATA 11,9,12,8,1,2,3,4,5,6,10,7,13 5880 FOR Y= 1 TO 13:READ M(Y):NEXT :RETURN :RETURN 5890 REM player's board 5900 CLS 5910 PRINT" ERRTHENTHENTHENFNTHENTHENTHENFNTHENTHENTHENFNTHENTHENTHENFNTHENTHENTHENFNTHENTHENTHENOPTION" 5920 PRINT"ACES........1CALL...CALL...CALL...CALL...CALL...CALL...CALL1" 5930 PRINT"TWOS........2CALL...CALL...CALL...CALL...CALL...CALL...CALL2" 5940 PRINT"THREES......3CALL...CALL...CALL...CALL...CALL...CALL...CALL3" 5950 PRINT"FOURS.......4CALL...CALL...CALL...CALL...CALL...CALL...CALL4 Y" 5960 PRINT"FIVES.......5CALL...CALL...CALL...CALL...CALL...CALL...CALL5 A" 5970 PRINT"SIXES.......6CALL...CALL...CALL...CALL...CALL...CALL...CALL6 H" 5980 PRINT" PSETTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHEN<0xB5!> T" 5990 PRINT"TOTAL UPPER..CALL...CALL...CALL...CALL...CALL...CALL...CALL Z" 6000 PRINT" PSETTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHEN<0xB5!> E" 6010 PRINT"3 OF A KIND.7CALL...CALL...CALL...CALL...CALL...CALL...CALL7 E" 6020 PRINT"4 OF A KIND.8CALL...CALL...CALL...CALL...CALL...CALL...CALL8" 6030 PRINT"FULL HOUSE..9CALL...CALL...CALL...CALL...CALL...CALL...CALL9" 6040 PRINT"SM STRAIGHT.ACALL...CALL...CALL...CALL...CALL...CALL...CALLA" 6050 PRINT"LG STRAIGHT.BCALL...CALL...CALL...CALL...CALL...CALL...CALLB" 6060 PRINT"YATZEE......CCALL...CALL...CALL...CALL...CALL...CALL...CALLC" 6070 PRINT"CHANCE......DCALL...CALL...CALL...CALL...CALL...CALL...CALLD" 6080 PRINT" PSETTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHEN<0xB5!>" 6090 PRINT"TOTAL LOWER..CALL...CALL...CALL...CALL...CALL...CALL...CALL" 6100 PRINT"TOP BONUS....CALL...CALL...CALL...CALL...CALL...CALL...CALL" 6110 PRINT"GRAND TOTAL..CALL...CALL...CALL...CALL...CALL...CALL...CALL" 6120 PRINT" ERLTHENTHENTHENSTEPTHENTHENTHENSTEPTHENTHENTHENSTEPTHENTHENTHENSTEPTHENTHENTHENSTEPTHENTHENTHENSAVE" 6130 FOR N=1 TO 5:LOCATE N*4-2,46:PRINT N;:NEXT 6140 RETURN 6150 LOCATE 25,1:PRINT STRING$(70," ");:LOCATE 25,1:RETURN 6160 ' KB INPUT AND ESCAPE 6170 KB$="":WHILE KB$="":KB$=INKEY$:WEND 6180 IF KB$=CHR$(27) THEN 4140 ELSE RETURN 6190 '** DONE - PRESS ENTER TO RETURN TO MENU **